home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tick.zip
/
TICKER.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-05-17
|
13KB
|
372 lines
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 1536,0,655360} {increased stack from 1024 to 1536; ver 1.01}
program ticker; {ticker tape display of a 25 line text file}
{*******************************************************}
{* Ticker.pas *}
{* Version 1.01 *}
{* *}
{* *}
{* TSR that will display up to 25 lines *}
{* of text in a continuous "Ticker-Tape" *}
{* stream. Ticker gets its input from a *}
{* disk based ascii text file and has the *}
{* ability to automatically update its *}
{* display with changed data. The display *}
{* stream can be sized and positioned any- *}
{* where on the screen through command line *}
{* switches. If the input file is deleted, *}
{* Ticker will stop displaying the stream *}
{* when it tries to check the file's time *}
{* stamp but will continue looking for the *}
{* file indefinitely. *}
{* *}
{* This feature could be used as a message *}
{* passing utility in a network environment. *}
{* *}
{* The following command line switches *}
{* are available: *}
{* *}
{* DEFAULT RANGE DESCRIPTION *}
{* *}
{* /R1 1..25 Row *}
{* /C1 1..79 Left column *}
{* /W80 2..80 Width *}
{* /S5 1..9 Display Speed *}
{* /T7 1..255 Text Color *}
{* /D60 1..999 File Check Delay in seconds *}
{* *}
{* Revision History *}
{* 1.01 Increased stack size and put Ticker *}
{* to sleep when the text file is not *}
{* available at startup. Bob Aman *}
{* *}
{* *}
{* *}
{* *}
{*******************************************************}
uses
dos,
tpcrt,
tpint,
tptsr;
const
credits1 =
'Ticker version 1.01 Copyright (c) by Bob Aman 1990, CSI 72727,3245';
delimit : string = ' '; {displayed line delimiter}
row : integer = 1; {display row; 1..25}
col : integer = 1; {display column; left edge; 1..79}
width : integer = 80; {display width; 1..80}
numofrows : integer = 1; {display size; 1}
speed : integer = 5; {display speed; 1..9}
attr : integer = 7; {Text color; 1..255}
fdelay : integer = 60; {check file delay; 1..999 seconds}
shutdown : boolean = false; {disable if no input file}
ln : byte = 1; {file line number}
maxlines = 26; {max lines readin from a file}
fname : string = ''; {input file name declaration}
pname : string = 'ticker'; {program id; so tsr won't be loaded twice}
timerint : byte = $1C; {timer control interrupt}
busy : boolean = false; {true if we are doing something}
int_handle = $10; {our handle; used for tsr management}
ctrlaltu : word = $0C16; {hot key to unload us; <CtrlAlt-U>}
altt : word = $0814; {hot key to ???; <Alt-T>}
var
linebuff : array[1..maxlines] of string[85]; {textfile line input}
displaybuff : string; {displayed text}
linelen : array[1..maxlines] of byte; {textfile line length}
opspeed, {display speed}
ticks : word; {timer tick count}
i, {general purpose counter}
charcount, {number of chars to append in one display cycle}
count : byte; {current position in linebuff}
origint : pointer; {original interrupt address}
tickerpophandle : byte; {handle for our display routine}
rowcol : word; {absolute coord. of cursor before we grab it}
saverow, {cursor row before we grab it}
savecol : byte; {cursor column before we grab it}
infile : text; {text file to display}
filetime, {used to get infile time stamp}
savetime : longint; {stores the time stamp of the file were showing}
linesread : byte; {number of lines read in}
timechanged : boolean; {true if filetime <> savetime}
fticks, {tick counter for checking time stamp}
checkftimedelay : longint; {delay for checking time stamp in ticks}
procedure loaddata;
var
i : word;
instr : string;
begin
assign(infile, fname);
{$I-}
reset(infile);
{$I+}
if ioresult = 0 then
begin
fillchar(linebuff, sizeof(linebuff), #0);
getftime(infile, savetime);
linesread := 1;
instr := '';
displaybuff := ''; {clear the display line}
while (linesread < maxlines) and (not eof(infile)) do
begin
readln(infile, instr);
linebuff[linesread] := delimit + copy(instr, 1, 80);
inc(linesread);
end;
timechanged := false;
close(infile);
for i := 1 to linesread do
linelen[i] := length(linebuff[i]);
ln := 1;
count := 1;
end
end;
procedure checkftime;
begin
assign(infile, fname);
{$I-}
reset(infile);
{$I+}
if ioresult = 0 then
begin
getftime(infile, filetime);
close(infile);
if savetime <> filetime then timechanged := true; {set reload flag}
if shutdown then timechanged := true;
fticks := 1;
shutdown := false;
end
else
begin
fticks := 1; {reset check-file tick counter}
shutdown := true; {turn us off}
end;
end;
function getone(var num : byte) : char;
begin
if num > linelen[ln] then
begin
num := 1;
if ln >= linesread then ln := 1
else
inc(ln);
end;
getone := linebuff[ln][num];
end;
procedure showit;
var
i : word;
begin
rowcol := wherexy;
savecol := lo(rowcol);
saverow := hi(rowcol);
for i := 1 to charcount do
begin
if (displaybuff[0] < char(width)) then
begin
displaybuff := displaybuff + getone(count);
end
else
displaybuff := copy(displaybuff, 2, width) + getone(count);
fastwrite(displaybuff, row, (col + width) - byte(displaybuff[0]), attr);
inc(count);
end;
gotoxyabs(savecol, saverow);
end;
{$F+}
procedure dispatcher(var regs : registers);
begin
busy := true;
if not shutdown then
begin
if timechanged then loaddata;
if fticks > checkftimedelay then checkftime;
reinitcrt;
if intextmode and (screenwidth = 80) then
showit;
end
else
if fticks > checkftimedelay then checkftime;
ticks := 0;
busy := false;
end;
{$F-}
{$F+}
procedure clocktick(bp : word); interrupt;
var
regs : intregisters absolute bp;
begin
inc(ticks);
inc(fticks);
if not busy then
if ticks > opspeed then
setpopticker(tickerpophandle, 60);
chainint(regs, origint);
end;
{$F-}
{$F+}
procedure popupunload(var regs : registers);
begin
busy := true;
popupsoff;
reinitcrt;
rowcol := wherexy;
savecol := lo(rowcol);
saverow := hi(rowcol);
if intextmode and (screenwidth = 80) then
if not disabletsr then
fastwrite('can`t disable', row, col, attr)
else
fastwrite('Ticker Tape Unloaded', row, col, attr);
gotoxyabs(savecol, saverow);
popupson;
busy := false;
end;
{$F-}
procedure initint;
begin
if initvector(timerint, int_handle, @clocktick) then
begin
writeln('Ticker Tape installed');
origint := isr_array[int_handle].origaddr;
end
else
writeln('ERROR Can`t grab the Timer Control interrupt, 1Ch...');
end;
procedure init;
begin
count := 1;
charcount := 1; {chars displayed in one cycle;could be used to increase speed}
ticks := 0;
fticks := 0;
checkftimedelay := fdelay * 18; {delay in ticks}
opspeed := 9 - speed;
displaybuff := '';
fillchar(linebuff, sizeof(linebuff), #0);
loaddata;
end;
function str2int(s : string; var n : integer) : boolean;
var
code : integer;
begin
str2int := false;
val(s, n, code);
if code = 0 then
str2int := true;
end;
procedure getparams;
var
temp : string;
begin
fname := paramstr(1);
assign(infile, fname);
{$I-}
reset(infile);
{$I+}
if ioresult <> 0 then
begin
writeln(fname + ' cannot be opened, continuing with installation...');
timechanged := true;
shutdown := true; {go to sleep; ver 1.01}
end
else
close(infile);
for i := 2 to paramcount do
begin
temp := paramstr(i);
case upcase(char(temp[2])) of
'R' : if not str2int(copy(temp, 3, 2), row) then halt;
'C' : if not str2int(copy(temp, 3, 2), col) then halt;
'W' : if not str2int(copy(temp, 3, 2), width) then halt;
'S' : if not str2int(copy(temp, 3, 1), speed) then halt;
'T' : if not str2int(copy(temp, 3, 3), attr) then halt;
'D' : if not str2int(copy(temp, 3, 3), fdelay) then halt;
end;
end;
{check bounds}
if row < 1 then row := 1;
if row > 25 then row := 25;
if col < 1 then col := 1;
if col > 70 then col := 79;
if width < 2 then width := 2;
if width > 80 then width := 80;
if speed < 1 then speed := 1;
if attr < 1 then attr := 1;
if fdelay < 1 then fdelay := 1;
end;
begin
if paramcount > 0 then
begin
getparams;
init;
if not moduleinstalled(pname) then
begin
installmodule(pname, nil);
if not definepopproc(tickerpophandle, @dispatcher,
ptr(sseg, sptr)) then exit;
initint;
if definepop(ctrlaltu, @popupunload, ptr(sseg, sptr), true) then
writeln('Press <CTRLALT-U> to Unload...');
popupson;
if not terminateandstayresident(paragraphstokeep + 16, 0) then
begin
writeln('Ticker Tape not installed..');
end;
end
else
writeln('Ticker Tape already installed.');
end
else
begin
writeln(credits1);
writeln;
writeln('Ticker is a TSR that will display up to 25 lines of text in a continuous');
writeln('"Ticker Tape" type stream. Ticker gets its input from a disk based');
writeln('ascii text file and has the ability to automatically update its display with');
writeln('changed data. The display stream can be sized and displayed anywhere on the');
writeln('screen through command line switches. If the input file is erased Ticker will');
writeln('stop streaming text until the input file reappears. This feature has several');
writeln('applications in a networked environment, i.e. passive message services. ');
writeln('Control is available through the following command line parameters');
writeln;
writeln(' DEFAULT RANGE DESCRIPTION');
writeln(' /R1 1..25 Row');
writeln(' /C1 1..79 Left column');
writeln(' /W80 2..80 Width');
writeln(' /S5 1..9 Display Speed');
writeln(' /T7 1..255 Text Color');
writeln(' /D60 1..999 File Check Delay in seconds');
writeln;
writeln(' TICKER CompletePath+TextFile.Ext [SWITCHES]');
end;
end.